home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / debug / mini-package.scm < prev    next >
Text File  |  1995-10-13  |  2KB  |  75 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. ; Miniature package system.  This links mini-eval up to the output of
  5. ; the package reifier.
  6.  
  7. (define (package names locs get-location uid) ;Reified package
  8.   (lambda (name)
  9.     (let loop ((i (- (vector-length names) 1)))
  10.       (if (< i 0)
  11.       (error "unbound" name)
  12.       (if (eq? name (vector-ref names i))
  13.           (contents (get-location (vector-ref locs i)))
  14.           (loop (- i 1)))))))
  15.  
  16. (define (make-simple-package opens foo1 foo2 name)
  17.   
  18.   (define bindings
  19.     (list (cons '%%define%%
  20.         (lambda (name val)
  21.           (set! bindings (cons (cons name val) bindings))))))
  22.  
  23.   (lambda (name)
  24.     (let ((probe (assq name bindings)))
  25.       (if probe
  26.       (cdr probe)
  27.       (let loop ((opens opens))
  28.         (if (null? opens)
  29.         (error "unbound" name)
  30.         (if (memq name (structure-interface (car opens)))
  31.             ((structure-package (car opens)) name)
  32.             (loop (cdr opens)))))))))
  33.  
  34. ; Structures
  35.  
  36. (define (make-structure package interface . name-option)
  37.   (cons package (vector->list interface)))
  38.  
  39. (define structure-interface cdr)
  40. (define structure-package car)
  41.  
  42.  
  43. ; Things used by reification forms
  44.  
  45. (define (operator name type-exp)
  46.   `(operator ,name ,type-exp))
  47.  
  48. (define (simple-interface names type) names)
  49.  
  50. ; Etc.
  51.  
  52. (define (transform . rest) (cons 'transform rest))
  53. (define (usual-transform . rest)
  54.   (cons 'usual-transform rest))
  55.  
  56. (define (transform-for-structure-ref . rest)
  57.   (cons 'transform-for-structure-ref rest))
  58. (define (inline-transform . rest)
  59.   (cons 'inline-transform rest))
  60.  
  61. (define (package-define! p name op) 'lose)
  62.  
  63.  
  64. ; --------------------
  65. ; ???
  66.  
  67. ; (define (integrate-all-primitives! . rest) 'lose)
  68.  
  69. ;(define (package-lookup p name)
  70. ;  ((p '%%lookup-operator%%) name))
  71.  
  72. ;(define (package-ensure-defined! p name)
  73. ;  (package-define! p name (make-location 'defined name)))
  74.  
  75.